'  RESOURCE.BAS - This module contains procedures that handle the
'resource list.



Option Explicit
Option Compare Text


'Resource structure
Type utResource
   Name As String       'resource name
   ID As Integer       'resource unique ID
End Type


Dim mvntCurrentResIndex As Variant   ' Contains the index of the current resource
                                    'or Empty if unintialized.  Check BOL()
                                    'or EOL() to see if miCurrentRes is
                                    'valid.


Dim mautResList() As utResource          ' Contains the list of all the resources (that
                                       'have task assignments) in the current project.

'  Loads the given combobox with the contents of the ResList.  Returns
'True if successful, False if not.
'
Function LoadResourceCombo (cboR As ComboBox) As Integer

   On Error GoTo LoadResCboError

   ' clear the combo box contents
   cboR.Clear

   ' Move to the first res in the list (if this causes an error,
   'then we'll bail out)
   ResourceFirst

   ' Now loop through the list, adding each resource name to the combo box
   While Not EOL()
      cboR.AddItem CurrentResName()
      ResourceNext
   Wend

   ' Check the results - does the number of items in the combo list
   'match the number of items in the ResList?
   If cboR.ListCount <> ResListCount() Then
      LoadResourceCombo = False
   Else
      LoadResourceCombo = True
   End If

   Exit Function

LoadResCboError:
   Select Case Err
      Case ERR_EMPTY_INDEX
         LoadResourceCombo = False
         Exit Function
      Case Else
         Resume Next
   End Select

End Function

'Counts the number of items in the ResList array.
Private Function ResListCount () As Integer

Dim nCount As Integer, iCRISave As Integer

On Error GoTo ResListCountError

'Save the current index position.
iCRISave = mvntCurrentResIndex
nCount = 0  'init counter
' Move to first resource - if this causes an error
'there probably are no resources, or the list is uninitialized.
ResourceFirst
'Loop through and count the resources.
While Not EOL()
   nCount = nCount + 1
   ResourceNext
Wend
'Restore the previous index position.
mvntCurrentResIndex = iCRISave
'Return the count.
ResListCount = nCount

Exit Function

ResListCountError:
   ResListCount = 0
   Exit Function

End Function

'  Moves the current resource index to the first resource in the list.
'
Sub ResourceFirst ()

'Check the value of mvntCurrentResIndex
If IsEmpty(mvntCurrentResIndex) Then
   Error ERR_EMPTY_INDEX   'user defined error code
Else
   'Check to see if we're before the beginning of the list...
   If BOL() Then
      'If so, move up one and check again...
      mvntCurrentResIndex = mvntCurrentResIndex + 1
      If BOL() Then
         ResourceFirst
      Else
         Exit Sub
      End If
   Else
      'move back one...
      mvntCurrentResIndex = mvntCurrentResIndex - 1
      If BOL() Then
         'Are we before the beginning of the list now?  If so, move up one.
         mvntCurrentResIndex = mvntCurrentResIndex + 1
      Else
         ResourceFirst
      End If
   End If
End If

End Sub

'  Moves the current resource index to the resource pointed to
'by Index.
'
Sub ResourceGoto (index As Integer)
Dim iSaveIndex As Integer

If IsEmpty(mvntCurrentResIndex) Then
   Error ERR_EMPTY_INDEX
Else
   iSaveIndex = mvntCurrentResIndex
   mvntCurrentResIndex = index
   If Not BOL() Then
      If Not EOL() Then
         Exit Sub
      Else
         mvntCurrentResIndex = iSaveIndex
         Error ERR_INVALID_INDEX
      End If
   Else
      mvntCurrentResIndex = iSaveIndex
      Error ERR_INVALID_INDEX
   End If
End If

End Sub

'  Moves the current resource pointer to the last resource in the list.
'
'  The code here is essentially a mirror image of the code in ResourceFirst.
Sub ResourceLast ()

'Check the value of mvntCurrentResIndex
If IsEmpty(mvntCurrentResIndex) Then
   Error ERR_EMPTY_INDEX   'user defined error code
Else
   If EOL() Then
      mvntCurrentResIndex = mvntCurrentResIndex - 1
      If EOL() Then
         ResourceLast
      Else
         Exit Sub
      End If
   Else
      mvntCurrentResIndex = mvntCurrentResIndex + 1
      If EOL() Then
         mvntCurrentResIndex = mvntCurrentResIndex - 1
      Else
         ResourceLast
      End If
   End If
End If

End Sub

'  Moves the current resource pointer to the next resource in the list.
'
Sub ResourceNext ()

If IsEmpty(mvntCurrentResIndex) Then
   Error ERR_EMPTY_INDEX
Else
   If Not EOL() Then
      mvntCurrentResIndex = mvntCurrentResIndex + 1
   Else
      Error ERR_EOL
   End If
End If

End Sub

'  Moves the current resource pointer to the previous resource in the list.
'
Sub ResourcePrevious ()

If IsEmpty(mvntCurrentResIndex) Then
   Error ERR_EMPTY_INDEX
Else
   If Not BOL() Then
      mvntCurrentResIndex = mvntCurrentResIndex - 1
   Else
      Error ERR_BOL
   End If
End If

End Sub

'  BOL - Beginning of List
'  Checks the current resource index to see if it points to a value
'that is before the first resource in the list.  Returns true if the
'index is before the first resource; false if not.
'
Private Function BOL () As Integer

Dim tmp, x

On Error GoTo BOLError

If IsEmpty(mvntCurrentResIndex) Then
   Error ERR_EMPTY_INDEX
Else
   x = LBound(mautResList)
   If mvntCurrentResIndex < x Then
      'if the current index is really less than the lower bound
      'of the mautResList, then this should cause an error and then
      'we'll set BOL True and exit.
      tmp = mautResList(mvntCurrentResIndex).ID
   End If
End If
BOL = False

Exit Function

BOLError:
   If Err = 9 Then   'subscript out of range
      BOL = True
      Exit Function
   Else
      Error Err
   End If

End Function

'  Returns the UID of the current resource.  Causes a run-time error if
'the current resource pointer is not valid. This procedure and
'CurrentResName() are the only ways that the rest of the application
'has to read the properties of the current resource.
'
Function CurrentResID () As Integer

If IsEmpty(mvntCurrentResIndex) Then
   Error ERR_EMPTY_INDEX
Else
   If Not BOL() Then
      If Not EOL() Then
         CurrentResID = mautResList(mvntCurrentResIndex).ID
      Else
         Error ERR_EOL
      End If
   Else
      Error ERR_BOL
   End If
End If

End Function

'  Returns the name of the current resource.  Generates a run-time
'error if the current resource pointer does not point to a valid
'resource in the list.  This procedure and CurrentResID() are the only
'ways that the rest of the application has to read the properties of
'the current resource.
'
Function CurrentResName () As String

If IsEmpty(mvntCurrentResIndex) Then
   Error ERR_EMPTY_INDEX
Else
   If Not BOL() Then
      If Not EOL() Then
         CurrentResName = mautResList(mvntCurrentResIndex).Name
      Else
         Error ERR_EOL
      End If
   Else
      Error ERR_BOL
   End If
End If

End Function

'  EOL - End of List
'  Checks the current resource index to see if it points to a value
'that is after the last resource in the list.  Returns True if the
'index points after the last resource; False if not.
'
Private Function EOL () As Integer

Dim tmp, x

On Error GoTo EOLError

If IsEmpty(mvntCurrentResIndex) Then
   Error ERR_EMPTY_INDEX
Else
   x = UBound(mautResList)
   If mvntCurrentResIndex > x Then
      'if the current index is really greater than the upper bound
      'of the reslist, then this should cause an error, then
      'we'll set EOL True and exit.
      tmp = mautResList(mvntCurrentResIndex).ID
   End If
End If
EOL = False

Exit Function

EOLError:
   If Err = 9 Then   'subscript out of range
      EOL = True
      Exit Function
   Else
      Error Err
   End If

End Function

'  Initializes the resource list with the names and UIDs all the
'resources that have task assignments.  The resource list is a
'module-scope array; this is the only procedure that actually
'modifies the resource list array.  We also alter mvntCurrentResIndex;
'it is set to true , but only if we are successful at intializing the
'ResList array.  Otherwise, mvntCurrentResIndex contains the Empty value.
'
'The Proj argument is a reference to a Winproj Project object.
'We return True if the array was successfully initialized with
'at least 1 resource; False if there were no resources in the
'project referred to by the Proj argument.  If a serious problem
'occurs, we'll generate a run-time error.
'
Function InitResourceList (oProj As Object) As Integer

Dim oRes As Object
Dim vntEmpty As Variant
Dim i As Integer, iRL As Integer
Dim nResCount As Integer
Dim nPct As Integer, fPct As Single, x As Single


On Error GoTo InitResListError



' Set mvntCurrentResIndex to an Empty value. If a move
'method, such as ResourceFirst() is used, it will
'check to see if mvntCurrentResIndex is Empty.  If so,
'the method will know that the ResList is uninitalized,
'and a run-time error will be generated.
mvntCurrentResIndex = vntEmpty

Set oRes = oProj.Resources
nResCount = oRes.Count
If Not (nResCount > 0) Then
   Beep
   MsgBox MB_NO_RESOURCES, MB_OK + MB_ICONEXCLAMATION, MB_TIMESHEET
   TerminateApplication
   Exit Function
End If

' This code is related to updating the progress bar on the splash form.
fPct = 75 / nResCount
x = 20

' Load the ResList array.
iRL = 0
For i = 1 To nResCount
   ReDim Preserve mautResList(iRL)
   mautResList(iRL).Name = oRes(i).Name
   mautResList(iRL).ID = oRes(i).ID
   iRL = iRL + 1
   
   ' Update the progress bar
   x = x + fPct
   Progress Int(x), PROG_RESASSIGN

Next i

' Do a check on the ResList before declaring success.
' Make sure we have at least one element in the array...
If UBound(mautResList) >= 0 Then
   'now check the first element for a UID...
   If mautResList(LBound(mautResList)).ID > 0 Then
      'and check the last element for a UID...
      If mautResList(UBound(mautResList)).ID > 0 Then
         'declare success!
         InitResourceList = True
         mvntCurrentResIndex = True
      End If
   End If
End If

Exit Function

InitResListError:

   Select Case Err
      Case 9   'subscript out of range
         'this probably means that something went wrong during the ResList check
         InitResourceList = False
         Exit Function
      Case 91  'object variable not set - there is a null resource
            i = i + 1
            Resume
      Case 429 To 440   'ole automation errors
         Resume Next
      Case Else
         Error Err
   End Select

End Function

